home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / DASCII.FOR < prev    next >
Encoding:
Text File  |  1988-02-08  |  3.3 KB  |  123 lines
  1.       SUBROUTINE DASCII ( STRING )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          DASCII           **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          DEASCII
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CALIF  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          REPLACE ALL NON-PRINTABLE CHARACTERS WITH A TEXT STRING
  23. C*          DENOTING THE CHARACTER.  FOR THE CHARACTERS FROM ASCII 0 TO
  24. C*          ASCII 31 AND ASCII 127, THE STRING IS THE THREE CHARACETER
  25. C*          MNEMONIC IN BRACKETS (EG, <ESC>).  FOR THE CHARACTERS FROM
  26. C*          ASCII 128 TO ASCII 255, THE STRING IS A THREE DIGIT NUMBER
  27. C*          IN BRACKETS (EG, <164>).
  28. C*
  29. C*     INPUT ARGUMENTS :
  30. C*          STRING - A CHARACTER STRING TO BE DE-ASCIIFIED.
  31. C*
  32. C*     OUTPUT ARGUMENTS :
  33. C*          STRING - THE DE-ASCIIFIED STRING (IN PLACE).
  34. C*
  35. C*     INTERNAL WORK AREAS :
  36. C*          NONE
  37. C*
  38. C*     COMMON BLOCKS :
  39. C*          NONE
  40. C*
  41. C*     FILE REFERENCES :
  42. C*          NONE
  43. C*
  44. C*     DATA BASE ACCESS :
  45. C*          NONE
  46. C*
  47. C*     SUBPROGRAM REFERENCES :
  48. C*          NONE
  49. C*
  50. C*     ERROR PROCESSING :
  51. C*          NONE
  52. C*
  53. C*     TRANSPORTABILITY LIMITATIONS :
  54. C*          NONE
  55. C*
  56. C*     ASSUMPTIONS AND RESTRICTIONS :
  57. C*          NONE
  58. C*
  59. C*     LANGUAGE AND COMPILER :
  60. C*          ANSI FORTRAN 77
  61. C*
  62. C*     VERSION AND DATE :
  63. C*          VERSION I.0     30-JAN-85
  64. C*
  65. C*     CHANGE HISTORY :
  66. C*          30-JAN-85    INITIAL VERSION
  67. C*
  68. C***********************************************************************
  69. C*
  70.       CHARACTER *255 WORK
  71.       CHARACTER *(*) STRING
  72.       CHARACTER *3 TABLE(0:32), THREE
  73.       DATA TABLE /'NUL',  'SOH',  'STX',  'ETX',  'EOT',  'ENQ',
  74.      $    'ACK',  'BEL',  ' BS',  ' HT',  ' LF',  ' VT',  ' FF',
  75.      $    ' CR',  ' SO',  ' SI',  'DLE',  'DC1',  'DC2',  'DC3',
  76.      $    'DC4',  'NAK',  'SYN',  'ETB',  'CAN',  ' EM',  'SUB',
  77.      $    'ESC',  ' FS',  ' GS',  ' RS',  ' US',  'DEL' /
  78. C
  79.       L = LEN ( STRING )
  80.       IF ( L .GT. 255 ) L = 255
  81.       IW = 0
  82.       WORK = ' '
  83.       DO 100 I = 1, L
  84. C
  85. C --- TEST FOR PRINTABILITY
  86. C
  87.          IF ((STRING(I:I) .LT. ' ') .OR. (STRING(I:I) .GT. '~')) THEN
  88.             IC = ICHAR ( STRING(I:I) )
  89.             IW = IW + 1
  90.             IF ( IW .GT. L ) GO TO 1000
  91.             WORK(IW:IW) = '<'
  92.             IW = IW + 1
  93.             IF ( IW+3 .GT. L ) GO TO 1000
  94. C
  95. C ------ SEE IF THERE IS AN ASCII MNEMONIC
  96. C
  97.             IF ( IC .LE. 31 ) THEN
  98.                THREE = TABLE(IC)
  99.             ELSE IF ( IC .EQ. 127 ) THEN
  100.                THREE = TABLE(32)
  101.             ELSE
  102. C
  103. C ------ NO MNEMONIC, USE THREE DIGIT NUMBER
  104. C
  105.                WRITE(THREE,900)IC
  106.             ENDIF
  107.             WORK(IW:IW+2) = THREE
  108.             IW = IW + 3
  109.             WORK(IW:IW) = '>'
  110.          ELSE
  111.             IW = IW + 1
  112.             IF (IW .GT. L) GO TO 1000
  113.             WORK(IW:IW) = STRING(I:I)
  114.          ENDIF
  115. 100      CONTINUE
  116. 1000  STRING = WORK
  117.       RETURN
  118. 900   FORMAT(I3)
  119.       END
  120. C
  121. C---END DASCII
  122. C
  123.